Cream of the Crop 1/Cream of the Crop 1.iso/PROGRAM/SPL.ARJ/PREDITOR.SP

Text File | 1991-09-26 | 21KB | 690 lines

BEGIN
     { Preditor : Program editor }

     { This program is written in The Structured Programming Language.
     You need to obtain the Structured Programming Language processor
     and process this program with it. A BASIC program will result and
     you will need to sort the program using SORT.EXE and then compile
     the program using any BASIC compiler. This program will run on
     MSDOS, PCDOS, or where there is compiled BASIC, such as on AMIGA,
     MACINTOSH, ATARI ST. You first must translate the program on MSDOS
     or PCDOS. You can obtain the Structured Programming Language from
     PC SIG at 800 245 6717, ask for DISK 666.
     Softdisk at 800 831 2694, ask for BIG BLUE DISK issue #16.
     Public Brand Software at 800 426 3475, ask for DISK BA-9.
     This program PREDITOR and The Structured Programming Language are
     both shareware. Certainly if you use the SPL processor to create
     a running program out of PREDITOR, then you should register both
     The SPL processor and this program, PREDITOR if you use them and
     like them. If you have questions, call me, Dennis Baer at work at
     516 694 5872. }

     INTEGER Found,                 { Sucessful find }
             I,J,                   { Counters }
             Character_pointer,     { Character pointer }
             Result,                { Result }
             File_open,             { File open }
             Current_line,          { Current line in file }
             Output_mode,           { Output mode }
             LE;                    { Logical end of file }

     STRING L,                { File record }
            Change_delimiter, { Delimiter used in the change command. }
            Ifile;            { Input file name. }

     INTEGER ARRAY PT(4000);  { Record pointers }

     STRING ARRAY OF(4000);  { File records }

     PROCEDURE INITIALIZE;   { Initialize file arrays, output messages. }
     BEGIN
          OUTPUT('*** PREDITOR version 1.0 ***');
          OUTPUT('    (c) Dennis Baer 1988');
          OPEN('LPT1:' FOR OUTPUT AS #7);  { Open printer }
          File_open := 0;  { File open set to zero, file not open }
          Change_delimiter := '!'; { Set default change delimiter }
          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               PT(I) := 0;  { Set pointer to record as null }
               OF(I) := ''; { Set record null }
          END
     END
 è     INTEGER LOW,HIGH,Low_line,High_line; { Line number variables }

     PROCEDURE OUTSCREEN(LOW,HIGH);
     BEGIN
          IF HIGH=0 THEN
          BEGIN
               OUTPUT('<' @ LOW @ '>' @ OF(PT(LOW)));
               Current_line := LOW;
               RETURN;
          END
          FOR I:= LOW STEP 1 UNTIL HIGH DO
          BEGIN
               OUTPUT('<' @ I @ '>' @ OF(PT(I)));
          END
          Current_line := HIGH;
     END

     PROCEDURE OUTPRINTER(LOW,HIGH);
     BEGIN
          FOR I:= LOW STEP 1 UNTIL HIGH DO
          BEGIN
               L := OF(PT(I));
               OUTPUT(#7, MID$(L,1,80));
               IF LEN(L) > 80 THEN
               BEGIN
                    L := MID$(L,81); OUTPUT(#7,L);
               END
          END
          Current_line := HIGH; OUTPUT();
     END

     STRING Search_string, Replace_string;

     PROCEDURE FIND(Search_string);
     BEGIN
          Found := 0;
          FOR J := Current_line STEP 1 UNTIL LE DO
          BEGIN
               Character_pointer := INSTR( OF(PT(J)), Search_string );
               IF Character_pointer <> 0 THEN
               BEGIN
                    Current_line := J;
                    Found := 1; RETURN;
               END
          END
          Current_line := 1;
     END

     PROCEDURE CHANGE(Search_string,Replace_string);
     BEGIN
          STRING Part_1, Part_2, Part_3;

          Found := 0;
          Character_pointer := INSTR( OF(PT(Current_line)), Search_string );
          IF Character_pointer = 0 THEN RETURN;è          IF Character_pointer = 1 THEN
          BEGIN
               Part_1 := '';
          END

          ELSE
          BEGIN
               Part_1 := LEFT$( OF(PT(Current_line)), Character_pointer-1 );
          END

          IF ( Character_pointer - 1 + LEN(Search_string) ) >
             LEN(OF(PT(Current_line))) THEN
          BEGIN
               Part_3 := '';
               Part_2 := Replace_string;
               OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
               Found := 1;
               OUTSCREEN(Current_line,0);
               RETURN;
          END

          ELSE
          BEGIN
               Part_3 := MID$( OF(PT(Current_line)), Character_pointer +
                                                     LEN(Search_string) );
               Part_2 := Replace_string;
               OF(PT(Current_line)) := Part_1 + Part_2 + Part_3;
               Found := 1;
               OUTSCREEN(Current_line,0);
               RETURN;
          END
     END

     PROCEDURE DELETE_LINES(LOW,HIGH);
     BEGIN
          INTEGER Temp;

          Temp := LOW;
          IF HIGH = 0 THEN HIGH := LOW;
          FOR J := LOW STEP 1 UNTIL HIGH DO
          BEGIN
               OF(PT(J)) := ''; PT(J) := 0;
          END
          IF HIGH < LE THEN
          BEGIN
               FOR J := HIGH + 1 STEP 1 UNTIL LE DO
               BEGIN
                    PT(Temp) := PT(J);
                    PT(J) := 0;
                    Temp := Temp + 1;
               END
          END
          Current_line := 1; LE := LE - (HIGH-LOW+1);
     END
 è     STRING Line;

     PROCEDURE INPUTLINE(Line);
     BEGIN
          INTEGER Temp;

          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               IF OF(I) = '' THEN
               BEGIN
                    Temp := I;
                    GO TO Found_blank;
               END
          END
          Found := 0;
          RETURN;

Found_blank:

          Found := 1;
          IF PT(1) = 0 THEN
          BEGIN
               Current_line := 1; LE := 1; PT(1) := Temp;
               OF(PT(1)) := Line; RETURN;
          END

          FOR I := LE + 1 STEP -1 UNTIL Current_line + 2 DO
          BEGIN
               IF LE = Current_line THEN GO TO Done_shifting;
               PT(I) := PT(I-1);
          END

Done_shifting:

          PT(Current_line + 1) := Temp; LE := LE + 1;
          OF(PT(Current_line + 1)) := Line;
          Current_line := Current_line + 1;
     END

     STRING File; { File name of open file. }

     PROCEDURE OPENFILE(File);
     BEGIN
          INTEGER Temp;

          IF File_open = 1 THEN
          BEGIN
               Result := 0;
               RETURN;
          END

          ONERRGOTO File_open_error;

          OPEN( File FOR INPUT AS #1 );
 è          ONERRGOTO File_read_error;

          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               IF EOF(1) THEN GO TO Success; { End of file. }
               LINEIN( #1,L); { Read record. }
               IF L = '' THEN L := ' '; { Null line set to a blank }
               PT(I) := I; OF(I) := L; Temp := I;
          END

Success:  CLOSE(#1); Result := 1; File_open := 1; { Set file open. }
          LE := Temp; Current_line := 1;
          RETURN;

File_open_error: Result := 0; OUTPUT('*** Error, opening file: ' @ File @
                                    ' ***');
          RESUME Finish_open;

File_read_error: Result := 0; OUTPUT('*** Error, reading file: ' @ File @
                                    ' ***');
          RESUME Finish_open;

Finish_open:

     END

     PROCEDURE SAVEFILE(File);  { Save text file. }
     BEGIN
          { If file is not open and no file name is given
            give error code and return. }

          Result := 1; { Assume result is 1, error will change result. }

          IF  File_open AND File = ''  THEN
          BEGIN
               Result := 0; RETURN;
          END

          IF LE = 0 THEN
          BEGIN
               OUTPUT('File: ' @ File @ ' is empty. ');
               Result := 0; RETURN;
          END

          IF File_open = 0 THEN
          BEGIN
               File_open := 1;
               OPEN(File FOR OUTPUT AS #1);
          END

          ELSE
          BEGIN
               OPEN(File FOR OUTPUT AS #1);
          END
 è          FOR I := 1 STEP 1 UNTIL LE DO
          BEGIN
               OUTPUT(#1,OF(PT(I)));
          END
          CLOSE(#1);
     END

     PROCEDURE CLOSEFILE(File);  { Close text file. }
     BEGIN
          IF File_open = 0 THEN
          BEGIN
               Result := 0; RETURN; { Error, no file is open. }
          END
          SAVEFILE(File); File := ''; { Save the file. }
          IF Result = 0 THEN RETURN;  { Error occurred. }
          File_open := 0; { File closed, no file open, once again. }

          FOR I := 1 STEP 1 UNTIL 4000 DO
          BEGIN
               PT(I) := 0; { Nullify pointer to line. }
               OF(I) := ''; { Set line null. }
          END
          LE := 0; { Set logical end to zero, empty file buffer. }
     END

     PROCEDURE REGISTER;
     BEGIN
          OUTPUT();
          OUTPUT(
          '*****************************************************************');
          OUTPUT(
          '*  This program PREDITOR has been developed by Dennis Baer.     *');
          OUTPUT(
          '*  If you use this program and you like it then make a pledge   *');
          OUTPUT(
          '*  of $25. Send a post card with your name and address on the   *');
          OUTPUT(
          '*  front and my name and address on the back and write $25 as   *');
          OUTPUT(
          '*  your pledge, also on back. Place this post card in a         *');
          OUTPUT(
          '*  business envelope and mail it to:                            *');
          OUTPUT(
          '*                                                               *');
          OUTPUT(
          '*  Dennis Baer                                                  *');
          OUTPUT(
          '*  25 Miller Road                                               *');
          OUTPUT(
          '*  Farmingdale,New York 11735                                   *');
          OUTPUT(
          '*                                                               *');
          OUTPUT(
          '*  When you receive your post card back, HONOR your pledge and  *');
          OUTPUT(è          '*  make check out for $25 to Dennis Baer. THANK YOU.            *');
          OUTPUT(
          '*  Registered users are entitled to software support.           *');
          OUTPUT(
          '*  Call 516 694 5872                                            *');
          OUTPUT(
          '*****************************************************************');
     END


     { Main program   }

     INITIALIZE;

     REGISTER;

     Ask:

     OUTPUT();
     OUTPUT('Edit'); OUTPUT('>' @);
     LINEIN(Line); { Get an input line }

     Remove_space:

     IF Line = ' ' OR Line = '' THEN
     BEGIN
          OUTPUT('Error, invalid Edit command '); GO Ask;
     END

     IF LEFT$(Line,1) = ' ' THEN  { Remove extra spaces from the left }
     BEGIN
          Line := RIGHT$(Line,LEN(Line)-1); GO Remove_space;
     END

{ *************************** STOP COMMAND ********************************** }


     IF Line = 'STOP' OR Line = 'stop' THEN
     BEGIN
         CLOSE();
         REGISTER;
         STOP;
     END

{ *************************** SAVE FILE COMMAND ***************************** }


     IF LEFT$(Line,1) = 'S' OR LEFT$(Line,1) = 's' THEN  { Save file }
     BEGIN
          IF MID$(Line,2,1) <> ' ' THEN
          BEGIN
               OUTPUT('Error, missing space'); GO Ask;
          END
          IF LEN(Line) <= 2 THEN
          BEGINè               Blank:

               OUTPUT('No file name entered.'); GO Ask;
          END

          Ifile := RIGHT$(Line,LEN(Line)-2);
          Result := 1; { Assume successful result beforehand }

          SAVEFILE(Ifile); { Save file buffer to disk }

          IF Result = 0 THEN
          BEGIN
               OUTPUT('Failure to save file ' @ Ifile); GO Ask;
          END
          GO Ask;
     END

{ *************************** CLOSE FILE COMMAND **************************** }

     IF LEFT$(Line,2) = 'CL' OR LEFT$(Line,2) = 'cl' THEN
     BEGIN
          Result := 1;  { Assume successful result at first }
          CLOSEFILE(Ifile);
          IF Result = 0 THEN
          BEGIN
               OUTPUT('Failure to close file ' @ Ifile); GO Ask;
          END
          GO Ask;
     END

{ *************************** OPEN FILE COMMAND ***************************** }

     IF LEFT$(Line,3) = 'OP ' OR LEFT$(Line,3) = 'op ' THEN
     BEGIN
          IF File_open = 1 THEN
          BEGIN
               OUTPUT('File ' @ Ifile @ ' is already open, error.');
               GO Ask;
          END
          Ifile := RIGHT$(Line,LEN(Line)-2);
          IF LEN(Line)<=3 THEN
          BEGIN
               OUTPUT('No file name entered, error.');
               GO Ask;
          END
          Result := 1; { Assume result is 1 }
          OPENFILE(Ifile);
          IF Result = 0 THEN
          BEGIN
               OUTPUT('Failure to open file ' @ Ifile);
               GO Ask;
          END
          GO Ask;
     END
 è{ *************************** LIST COMMAND ********************************** }

     IF LEFT$(Line,1) = 'L' OR LEFT$(Line,1) = 'l' THEN
     BEGIN
          Output_mode := 0; { Set output mode to list }
          IF Line = 'L' OR Line = 'L ' OR Line = 'l' OR Line = 'l ' THEN
          BEGIN
               Low_line := Current_line; High_line := Current_line;
               GO Check_and_print;
          END

          The_rest:

          IF MID$(Line,2,1) <> ' ' THEN
          BEGIN
               OUTPUT('Missing space'); GO Ask;
          END
          Line := RIGHT$(Line,LEN(Line)-2);
          Low_line := VAL(Line);
          IF Low_line <= 0 THEN
          BEGIN
               OUTPUT('Invalid low line number'); GO Ask;
          END
          Character_pointer := INSTR(Line,',');
          IF Character_pointer = 0 THEN
          BEGIN
               High_line := Low_line;
               GO Check_and_print;
          END
          IF Character_pointer = LEN(Line) THEN
          BEGIN
               OUTPUT('No high line number entered');
               GO Ask;
          END
          Line := MID$(Line,Character_pointer+1);
          IF Line = '*' THEN
          BEGIN
               High_line := LE;
               GO Check_and_print;
          END
          High_line := VAL(Line);
          IF High_line <=0 THEN
          BEGIN
               OUTPUT('Invalid high line number');
               GO Ask;
          END

          Check_and_print:

          IF Low_line  > LE  OR
             Low_line  < 1   OR
             High_line > LE  OR
             High_line < 1   THEN
          BEGIN
               OUTPUT('Line number out of bounds');è               GO Ask;
          END
          IF Low_line > High_line THEN
          BEGIN
               OUTPUT('First line number higher than second line number');
               GO Ask;
          END

          IF Output_mode = 1 THEN
          BEGIN
               OUTPRINTER(Low_line,High_line); GO Ask;
          END

          IF Output_mode = 0 THEN
          BEGIN
               OUTSCREEN(Low_line,High_line); GO Ask;
          END

          IF Output_mode = 2 THEN
          BEGIN
               DELETE_LINES(Low_line,High_line); GO Ask;
          END
     END

{ *************************** TOP COMMAND *********************************** }

     IF Line = 'T' OR Line = 't' THEN
     BEGIN
          Current_line := 1;
          OUTPUT('Top');
          GO Ask;
     END

{ *************************** PRINT COMMAND ********************************* }

     IF LEFT$(Line,1) = 'P' OR LEFT$(Line,1) ='p' THEN
     BEGIN
          Output_mode := 1;
          IF Line = 'P' OR Line = 'P ' OR Line = 'p' OR Line = 'p ' THEN
          BEGIN
               High_line := Current_line;
               Low_line := Current_line;
               GO Check_and_print;
          END

          ELSE GO TO The_rest;
     END

{ *************************** DELETE COMMAND ******************************** }

     IF LEFT$(Line,1) = 'D' OR LEFT$(Line,1) = 'd' THEN
     BEGIN
          Output_mode := 2;  { delete is mode 2 }
          IF Line = 'D' OR Line ='D ' OR Line = 'd' OR Line = 'd ' THEN
          BEGINè               Low_line := Current_line;
               High_line := Current_line;
               GO Check_and_print;
          END

          ELSE GO TO The_rest;
     END

{ *************************** CHANGE COMMAND ******************************** }

     IF LEFT$(Line,1) = 'C' OR LEFT$(Line,1) = 'c' THEN
     BEGIN
          STRING Search,     { Contains search string }
                 Replace;    { Contains replacement string }

          Line := MID$(Line,2);

          Strip_blank:

          IF LEFT$(Line,1) = ' ' THEN
          BEGIN
               Line := MID$(Line,2);
               GO Strip_blank;
          END
          IF LEFT$(Line,1) <> Change_delimiter THEN
          BEGIN
               OUTPUT('Missing ' @ Change_delimiter);
               GO Ask;
          END
          Search := ''; Line := MID$(Line,2);
          IF LEN(Line) = 0 THEN
          BEGIN
               OUTPUT('Error, search string is null'); GO Ask;
          END
          IF MID$(Line,1,1) = Change_delimiter THEN
          BEGIN
               OUTPUT('Error, no string entered for search');
               GO Ask;
          END

          Build:

          Search := Search + MID$(Line,1,1); Line := MID$(Line,2);
          IF Line = '' THEN
          BEGIN
               OUTPUT('Missing ' @ Change_delimiter);
               GO Ask;
          END
          IF LEFT$(Line,1) <> Change_delimiter THEN GO Build;
          Replace := MID$(Line,2); { Get replacement string }
          CHANGE(Search,Replace);
          IF Found = 0 THEN
          BEGIN
               OUTPUT('String:' @ Search @ ' not found');
               GO Ask;è          END
          GO Ask;
     END

{ *************************** FIND COMMAND ********************************** }

     IF LEFT$(Line,1) = 'F' OR LEFT$(Line,1) = 'f' THEN
     BEGIN
          STRING Search;  { String to search for }

          IF Line = 'F' OR Line = 'F ' OR Line = 'f' OR Line = 'f ' THEN
          BEGIN
               OUTPUT('Missing search string');
               GO Ask;
          END

          Line := MID$(Line,2);

          Strip:

          IF LEFT$(Line,1) = ' ' THEN
          BEGIN
               Line :=MID$(Line,2);
               GO Strip;
          END

          IF MID$(Line,1,1) <> Change_delimiter THEN
          BEGIN
               OUTPUT('Missing ' @ Change_delimiter);
               GO Ask;
          END
          Search := ''; Line := MID$(Line,2);
          IF LEN(Line) = 0 THEN
          BEGIN
               OUTPUT('Missing string to be found');
               GO Ask;
          END
          IF MID$(Line,1,1) = Change_delimiter THEN
          BEGIN
               OUTPUT('Error, null search string');
               GO Ask;
          END

          Build_1:

          Search := Search + MID$(Line,1,1); Line := MID$(Line,2);
          IF Line = '' THEN
          BEGIN
               OUTPUT('Missing ' @ Change_delimiter);
               GO Ask;
          END
          IF LEFT$(Line,1) <> Change_delimiter THEN GO Build_1;
          FIND(Search);
          IF Found := 0 THEN
          BEGINè               OUTPUT('String: ' @ Search @ ' not found');
               Current_line := 1;
               GO Ask;
          END
          GO Ask;
     END

{ *************************** BOTTOM COMMAND ******************************** }

     IF Line = 'B' OR Line = 'b' THEN
     BEGIN
          Current_line := LE;
          OUTPUT('Bottom at line: ' @ Current_line);
          GO Ask;
     END

{ *************************** INPUT COMMAND ********************************* }

     IF Line = 'I' OR Line = 'i' THEN
     BEGIN
          OUTPUT('Input'); OUTPUT('>' @);
          Line := '';

          Inline:

          LINEIN(Line);
          IF Line = '' THEN GO Ask;
          INPUTLINE(Line);
          IF Found = 1 THEN
          BEGIN
               OUTPUT('>' @);
               GO Inline;
          END
          OUTPUT('Input stopped, input buffer is full');
          GO Ask;
     END

     OUTPUT('Invalid Edit command:' @ Line); GO Ask;

     { End of program }

END